perm filename ACCEL.F4[LX,LCS] blob
sn#164490 filedate 1975-06-13 generic text, type T, neo UTF8
SUBROUTINE ACCEL
COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
1 ,P1(27),JFM(4),COPY(30),IFM(80)
1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
1 PARENS,JZ,BY,JED,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,RAX,RD
C /C/=26
IF(T5.EQ.1)GO TO 4020
7020 RA=V(IA+K)
IF(RA.EQ.10000.)RETURN
4020 RD=1
IF(RA.LT.0)RD=-1.
RA=RA*RD
IF(KA.EQ.0)RA=RA-RC
W=RA
RB=W
IF(W.LE.Z)GO TO 2020
IF(Z.NE.0)GO TO 3020
RA=RA/Y
RB=-1.
RC=0
GO TO 8020
3020 W=Z
RC=W+RC
GO TO 24
2020 RC=0
24 IF(X.NE.Y)GO TO 424
RA=W/X
GO TO 8020
C DUR OF TMP + BG TIME OF TMP - NOTE VALUE -
C BG TIME OF NOTE. CHN=TBG.
424 RAX=XT(J)
RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
XT(J)=RAX+YY*RA
8020 IF(KA.EQ.0)RA=RA+PR
KA=1
IF(RC.NE.0)GO TO 1011
IF(T5.EQ.1)RETURN
C T5=1 IN 'RUNIT'
V(IA+K)=RA*RD
IF(K.EQ.IZ)RETURN
C*********** JUNE 1,71
1011 IF(T5.EQ.1)GO TO 2011
K=K+1
IF(ZZ.NE.0)Z=Z-W
IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020
IC=IC+1
IF(RB.EQ.W)RETURN
KA=0
K=K-1
RETURN
2011 PR=RA
IF(K.GT.1)GO TO 9020
K=I-6
ZPAR=-9900.-CHN-ZZ
DO 3011 KL=8,I
IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020
3011 K=K-1
9020 W=ZZ
IF(V(K+3))K=K+3
C ABOVE IS FOR TYPED IN TEMPO CHANGES
KA=K+3
ZZ=V(KA)
C DUR OF NEXT TEMPI
X=V(KA+1)
Y=V(KA+2)
213 KA=0
Z=ZZ
CALL SQYY(YY,X,Y,Z)
CHN=CHN+W
XT(J)=X
IF(KA.EQ.1)Z=0
RA=PR
KA=0
K=K+3
GO TO 4020
END
SUBROUTINE POINTR(INUM,IPAR,ISTRT,KODE)
COMMON/A/ V(2000)
C TO FIND POINTERS TO LISTS, ETC. IN V ARRAY WHEN USING SUBR.
C KODES: -22=RHY -33=NOTES -44=NUMS -46=RLIST -36=RNOTES
C -11=SUBN -12=SUBR -55=MOVE NUMS -56=MOVE NOTES
C -66=DUPL -88=LIT -57=MOVE RANGE NUMS -58=MOVE RNG NOTES
DO 1 K=1,2000
N=V(K)
IF(N.LT.10000)GO TO 1
IF(N/10000.NE.INUM)GO TO 1
IF(MOD(N,10000).NE.IPAR)GO TO 1
ISTRT=K+4
KODE=V(K+2)
ICNT=V(K+3)
IF(IABS(KODE).LT.11)ISTRT=ISTRT-1
RETURN
C FINDS FIRST OCCURRENCE OF PARAM AND INST ONLY.
1 CONTINUE
END